perm filename MSS.F4[NEW,LCS]22 blob
sn#372833 filedate 1978-08-09 generic text, type T, neo UTF8
00100 C ********** DISPLAYS MUSIC AND DRAWS IT ON THE PLOTTER **********
00200 C *** READS DATA FROM CLEFA-B-C-ETC., BDR40,BDI40, ETC.
00300
00400 IMPLICIT INTEGER(A-Q,S-Z)
00500 REAL DIS,DISX,A,B,STFF,CENTR,POS ,UD,XDIS
00600 DIMENSION LST(18),DP(0/7)
00700 COMMON /DL/X22,SAVER,NAME,EXT /RRJJ/RJJ2,RJJ(20) /FONT/JFONT
00800 1 /RINP/R(10,80),RPOS(2,50),RI(200) /RMOD/RMODE2,RSET4,IBEAM,
00900 1 NOSET,STEM,STUP,NTC,ENDP,RAD,RDD,ITB,POSB
01000 1 /FRMT/F78F(1),FA1(1),FA5(1),ASK /SIZ/RSZ,JCEN,KCEN
01100 C ORDER OF COMMON MUST! REMAIN AS IS (FOR DMP MODE READ)
01200 COMMON /LIMIT/LIMIT,ITEM,L,I,IX,ITEMX,ILIM
01300 1 /STF/RSTFAC(0/7),RSTJ2
01400 1 /POSI/STFF(0/7),JJ2,POS /ALF/INP(72),ML
01500 1 /SCM/V(78),ISCR,LCNT,RSTF,LIST(200),REND
01600 1 /UPDWN/ RL,UD /IDEV/IDEV /NUM/NUM(10),JRD
01700 1 /PLTR/PLT,RHT,DIS,XDIS /PTR/PWDS(350)
01800 CC COMMON /PLTR/PLT,RHT,DIS,XDIS/PTR/PWDS(250),ITEM,L,I,IX
01900 COMMON/A2Z/LAA,LBB,LCC,LDD,LEE,LFF,LGG,LHH,LII,LJJ,LKK,LEL,
02000 1 LMM,LNN,LOH,LPP,LQQ,LRR,LSS,LTT,LUU,LVV,LWW,LXX,LYY,LZZ
02100 COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20) /RNW/RNW /MKS/MKS(14)
02200 1 /XRN/RN(3000) /DPY/ST(4000),MEDIT,IGO /DPTR/WDS(350)
02300 1 /MKX/MKX(11) /SC/SSC(72) /JCHAR/IXX,ISEMI,IBLA,IG
02400 CC COMMON/XRN/RN(2500)/DPY/ST(4000),WDS(250),MEDIT,IGO
02500 EQUIVALENCE (J3,JQ(1)),(J4,JQ(2)),(J5,JQ(3)),(R5,RJQ(3)),
02600 1 (R6,RJQ(4)),(J10,JQ(8)),(J6,JQ(4)),(R4,RJQ(2)),(R7,RJQ(5))
02700 1,(R3,RJQ(1)),(I2,INP(2)),(I1,INP(1)),(I3,INP(3)),(RJ13,RJJ(11))
02800 1,(R11,RJQ(9)),(NJR,R10,RJQ(8)),(R8,RJQ(6)),(RJ3,RJJ(1)),(R9,
02900 1 RJQ(7)),(RX3,RJQ(20)),(ST2,ST(2)),(R13,RJQ(11)),(J8,JQ(6))
03000 1 ,(J13,JQ(11)),(IPOS,POS),(LST(13),K),(LST(14),X),(LST(15),J)
03100 1 ,(I7,INP(7)),(IM,MKS(5)),(IP,MKS(11)),(IR,MKS(13)),(IU,MKS(8)),
03200 1 (IC,MKS(12)),(IA,MKS(2)),(IFF,MKS(3)),(IT,MKS(6)),(IOO,MKS(14)),
03300 1 (IS,MKS(4)),(ID,MKS(7)),(II,MKS(10)),(IW,MKS(1)),(IH,MKS(9))
03400 1 ,(MINUS,MKX(10)),(LESS,MKX(3)),(IGT,MKX(4))
03500 DATA NUM/'0','1','2','3','4','5','6','7','8','9'/,JRD/0/,ILIM/350/
03600 1 ,STFF/-469.,-346.,-223.,-100.,23.,146.,269.,392./,RSTFAC/8*1./
03700 1 ,LST/'NOTE','REST','CLEF','LINE','SLUR','BEAM','TRILL','STAFF',
03800 1 'MISC','NUMB','LIBRY','CIRCL',0,0,0,'WORD','KSIG','METER'/,
03900 1DP/8*1/,IE/'E'/,IJ/'J'/,RNW/2.44/,IL/'L'/,INN/'N'/,LCNT/1/,LIMIT
04000 1/3000/,IQ/'Q'/,IZ/'Z'/,IB/'B'/, DIS/1.0/, RHT/1.0/,EXT/'DMD'/
04100 DATA MKS/'W','A','F','S','M','T','D','U','H','I','P','C','R','O'/
04200 C THE GIANT NUMBERS ARE FOR [ AND ]
04300 DATA MKX/'/',';','<','>',-19728949184,-18655207360,'(',')','.'
04400 1,'-','*'/,SSC(14)/'X'/,SSC(15)/';'/,SSC(72)/' '/
04500 C LIMIT IS MAIN ARRAY LENGTH (3000)
04600 C 350 LIM. ON ITEMS PWDS, WDS (SEE ALSO 571 TO 170)
04700
04800 C***** CALL SEGFIX
04900 C FOR UPPER SEGMENTS USED BY MORE THAN 1 JOB (SEGFIX.FAI[TVR])
05000 LCEN=0
05100 MCEN=0
05200 IDEV=5
05300 I1=0
05400 2 CALL DPYSET(1,ST,4000)
05500 CALL HYDPOG(2)
05600 CALL HYDPOG(1)
05700 CALL TYPLOC(450,0)
05800 CALL DPYBRT(5)
05900 DO 299 K=1,I
06000 CLEARS ARRAY FOR RESTART OF 'SETUP' ROUTINE
06100 299 RN(K)=0
06200 JFONT=0
06300 IX=0
06400 RSET4=999
06500 QUICK=0
06600 CB=0
06700 C CB IS CENTER-BIG (CENTERING RANGE=6)
06800 UD=1
06900 RL=1
07000 FSCN=LEL
07100 RPOS(1,1)=0
07200 RSZ=.845
07300 X22=0
07400 JCEN=0
07500 KCEN=0
07600 PLT=0
07700 PWDS(1)=1
07800 EDX=-1
07900 RN(2)=0
08000 C FOR RESTART. AVOIDS STAFF CODE NUM.
08100 SAVER=4
08200 DO 1402 K=0,7
08300 1402 RSTFAC(K)=1.
08400 REDIT=999.
08500 M=1
08600 ITEM=0
08700 ITEMX=0
08800 ZERO=-1
08900 WDS(1)=4
09000 C DATA IN DPY ARRAY STARTS AT WD.4!
09100 I=1
09200 1100 SCORE=-1
09300 58 IGO=-1
09400 IF(I1.NE.IR)GO TO 5505
09500 I1=-1
09600 CALL NAMEXT(INP,NAME,EXT)
09700 J2=0
09800 IF(NAME.NE.IBLA)GO TO 1221
09900 C YOU CAN TYPE 'RS NAME' FOR QUICK RESTARTS
10000 GO TO 5505
10100
10200 11 CALL NOTWRT
10300 57 IF(M.GT.I)GO TO 571
10400 IF(IGO)CALL DPYOUT(1)
10500 571 ITEM=ITEM+1
10600 IF(ITEM.LT.ILIM)GO TO 17
10700 CALL TYPSTR('**** TOO MANY ITEMS')
10800 CALL TYPINT(ITEM)
10900 CALL TYPSTR('/349')
11000 CALL TYPCRLF
11100 CCCC TYPE 170,ITEM
11200 I=PWDS(ILIM)
11300 ITEM=ILIM-1
11400 ST2=WDS(ILIM)
11500 CALL DPYOUT(1)
11600 GO TO 1100
11700 CCC170 FORMAT(2(' **** TOO MANY ITEMS ',I3,'/299'/))
11800 17 IF(IGO.GT.0)GO TO 20000
11900 K=ST2
12000 IF(X22.EQ.0)GO TO 20000
12100 CALL BOX(IBOX,RBOX)
12200 ST2=K
12300 20000 WDS(ITEM+1)=ST2
12400 IF(EDX.EQ.-1)GO TO 1571
12500 IF(M.LT.I)GO TO 6120
12600 C SL=SAVE AFTER RESETTING LENGTH OF PAGE. (SEE I2 IN SCX)
12700 1571 PWDS(ITEM+1)=I
12800 PLT=0
12900 IF(IGO.NE.0)GO TO 55
13000 CALL DPYOUT(1)
13100 IF(SCORE.EQ.0)GO TO 9532
13200 C GO GET MORE FROM SCX.
13300 IGO=-1
13400
13500 55 IF(SCORE.EQ.0)GO TO 653
13600 5505 SVST=ST2
13700 C CATCHES TYPO WITH 'C'
13800 K=ITEM+1
13900 IF(X22.EQ.0)GO TO 5503
14000 C 'N' SUPPRESSES TYPE-OUT, 'P' OR NEW ITEM RESTORES IT.
14100 IF(QUICK)5911,210,10
14200 C -1=QUICK MODE, +1=SUPPRESS TYPE-OUT OF PARAMS
14300 210 L=RN(MEDIT+1)
14400 K=X22
14420 IF(IDEV.EQ.1)GO TO 5503
14460 C 'FILE'CAN BE USED WHILE IN EDIT MODE
14500 CC IF(L.EQ.11.OR.L.EQ.12)L=9
14600 CC IF(L.EQ.13)L=11
14700 CC IF(L.GE.15)L=L-5
14800 CCCC TYPE 427,LST(L),(RN(L),L=MEDIT+1,MEDIT+3)
14900 CALL TYPCRLF
15000 CALL TYPWRD(LST(L))
15100 CALL TYPCRLF
15200 CALL TYPFLT(RN(MEDIT+1))
15300 CALL TYPCHR(' ',3)
15400 CALL TYPFLT(RN(MEDIT+2))
15500 CALL TYPCHR(' ',3)
15600 CALL TYPFLT(RN(MEDIT+3))
15700 CCCCC TYPE 1427,(RN(L),L=MEDIT+1,MEDIT+3)
15800 IF(YED.LT.2)GO TO 59
15900 C YED IS SET AT 426
16000 DO 5501 L=4,YED+2
16100 CALL TYPCHR(' (',4)
16200 CALL TYPINT(L)
16300 CALL TYPCHR(') ',2)
16400 5501 CALL TYPFLT(RN(MEDIT+L))
16500 CALL TYPCRLF
16600 CCC5501 TYPE 4271,L,RN(MEDIT+L)
16700 GO TO 59
16800
16900 CCCC5919 FORMAT(' ;=LFT :=RT (=UP )=DN /=HALF *=*2'/)
17000 591 IF(X22.EQ.0)GO TO 59
17100 QUICK=-1
17200 CALL TYPSTR(';=LFT :=RT (=UP )=DN /=HALF *=*2')
17300 CALL TYPCRLF
17400 CCCC TYPE 5919
17500 5911 CALL FSCAN
17600 C FNUM.FAI=FAST COMMANDS ;=← :=→ (=↑ )=↓ /=HALF *=*2 X=X C=C OTHERS=CR
17700 GO TO 1591
17800 GO TO 2591
17900 GO TO 3591
18000 GO TO 4591
18100 GO TO 5913
18200 GO TO 6591
18300 GO TO 7591
18400 GO TO 5912
18500 I1=0
18600 5591 QUICK=0
18700 GO TO 5917
18800
18900 1502 FORMAT(2A5)
19000 502 REREAD 1502,K,K
19100 IF(LOOK(K)+LOOKD(K))GO TO 2502
19200 CALL TYPSTR(' FILE NOT FOUND')
19300 GO TO 59
19400 2502 CALL IFILE(1,K)
19500 2503 IDEV=1
19600 GO TO 10
19700 CC IF(I1.NE.LOH)GO TO 10
19800 3502 IDEV=5
19900 GO TO 59
20000 C RESET TO TTY MODE
20100
20200 5503 CALL HYDPOG(3)
20300 C TO DELETE VERTICAL LINE (55)
20400 KED=0
20500 QUICK=0
20600 C RESET PARAM TYPE-OUT
20700 RJ13=0
20800 C KILL CENTERING FEATURE FOR NOW
20900 CC** NEXT DOES THIS FASTER*** 59 TYPE 56,NAME,K,I,SVST
21000 59 IF(IDEV.EQ.1)GO TO 10
21100 CALL TYPCRLF
21200 CALL TYPWRD(NAME)
21300 CALL TYPSTR(' TYPE FOR ITEM #')
21400 CALL TYPINT(K)
21500 CALL TYPSTR(' ')
21600 CALL TYPINT(I)
21700 CALL TYPSTR(' ')
21800 CALL TYPINT(SVST)
21900 CALL TYPCRLF
22000 10 SCORE=-1
22100 CQQ ACCEPT 89,INP
22200 READ(IDEV,89,END=3502)INP
22300 IF(I1.EQ.LESS)GO TO 3502
22400 C '<' = TEMPORARY ESCAPE FROM 'FILE' MODE
22500 IF(I1.NE.IGT)GO TO 1000
22600 IF(X22.NE.0)GO TO 59
22700 C '>' = RETURN TO 'FILE' MODE - IF NOT STILL EDITING.
22800 GO TO 2503
22900 1000 IF(IDEV.EQ.5)GO TO 4502
23000 IF(I7.NE.IT)GO TO 4502
23100 IF(I1.NE.LCC)GO TO 4502
23200 C 'ET' DIRECTORY? UGH!!!
23300 6502 READ(IDEV,89)INP
23400 IF(I3.NE.ISEMI)GO TO 6502
23420 READ(IDEV,89)INP
23460 C READ AGAIN TO GET PAGE MARK - OR SOMETHING???
23500 GO TO 10
23600 4502 REREAD 1,J,R2,RJQ
23700 C ↑↑↑ 1/78
23800 C ↓↓↓↓ FIRST CATCHES BLANKS, NUMBERS, ETC.
23900 5917 IF(I1.GE.MINUS)GO TO 110
24000 IF(I1.EQ.IBLA)GO TO 110
24100 IF(I1.EQ.II)GO TO 678
24200 C IN, ITEM
24300 IF(I1.EQ.IXX)GO TO 78
24400 C X=EXIT
24500 IF(I1.EQ.LEL)GO TO 778
24600 C L=LEFT, LP=LIGHT PEN
24700 IF(I1.EQ.IU)GO TO 883
24800 C UP
24900 IF(I1.EQ.IR)GO TO 8835
25000 C R=RIGHT, RI=RIT, READ, RS=RESTART
25100 IF(I1.EQ.LDD)GO TO 478
25200 C D=DOWN, DI=DIM, DE=DELETE
25300 IF(I1.EQ.LCC)GO TO 178
25400 C C=COPY, CR=CRESC., CN=CENTER, CH=ON HEAD, CT=ON TAIL
25500 IF(I1.EQ.IS)GO TO 15
25600 C SAVE, SPACING STAFF, STAFF, SHOW, SF, SFZ, SCALE, STC=STACCATO
25700 IF(I1.EQ.LEE)GO TO 878
25800 C ED=EDIT WITH POS. FIRST, E=EDIT WITH LIGHT PEN, ES=EDIT WITH STAFF NUM. FIRST
25900 IF(I1.EQ.INN)GO TO 410
26000 C N=NO TYPE
26100 IF(I1.EQ.IP)GO TO 33
26200 C P,PP,PPP, P N=PRINT PARAM N., PR=PRINT PARAM LIST, POCO, PIU, PZ=PIZZ,PL=PLUS
26300 IF(I1.EQ.LAA)GO TO 378
26400 C A=ADJUST TO SET, AD=ADJUST STEMS, AC=ACCEL, AR=ARCO, AT=A TEMPO, ACT=ACCENT
26500 IF(I1.EQ.IQ)GO TO 591
26600 C Q=QUICK
26700 IF(I1.EQ.IT)GO TO 441
26800 C T=TYPE TEXT, T=TYPE OUT, TE=TENUTO, TL=TYPLOC
26820 IF(I1.EQ.LFF)GO TO 2442
26860 C F,FF,FFF,FE=FERMATA,FILE(TO READ COMMAND FILE)
26900 IF(X22.NE.0)GO TO 59
27000 C NEXT CANNOT HAPPEN IN EDIT MODE.
27100 IF(I1.EQ.IZ)GO TO 24
27200 C ZOOM
27300 IF(I1.EQ.IM)GO TO 7555
27400 C M=MOVE, ME=MENO, MO=MOLTO, MF,MP
27500 IF(I1.EQ.IJ)GO TO 7555
27600 C JUSTIFY
27900 IF(I1.EQ.LGG)GO TO 120
28000 C GET, GM=GET MORE
28100 IF(I1.EQ.LHH)GO TO 1678
28200 C H=HARMONIC, HW=HEAVY WEDGE
28300 IF(I1.EQ.IW)GO TO 1778
28400 C W=WEDGE ACCENT
28500 IF(I1.EQ.'(')GO TO 7378
28600 IF(I1.EQ.')')GO TO 7478
28700 IF(I1.EQ.',')GO TO 7778
28800 C LEFT AND RIGHT PARENTHESES AND COMMA
28900 IF(I1.NE.LBB)GO TO 59
29000 C******* ADD MORE LETTER ITEMS HERE *************
29100 C BRC=BRACE, BRK=BRACKET -- FOR FRONT OF LINE. BAR=BAR LINE.
29200 IF(X22.NE.0)GO TO 59
29300 REREAD 1,JA,JA,JA,R2,RJQ
29400 J=4
29500 R7=4
29600 IF(I3.EQ.IR)R7=0
29700 IF(I3.EQ.LCC)R7=5
29800 GO TO 110
29900
30000 378 IF(I2.EQ.LDD)GO TO 886
30100 C 'A' = ALTER(GO TO 112) ADJUST(GO TO 886) ACCEL(GO TO 7813)
30200 IF(X22.NE.0)GO TO 886
30300 IF(I2.EQ.IT)GO TO 7178
30400 C AT=A TEMPO
30500 IF(I2.EQ.IR)GO TO 7278
30600 C AR=ARCO
30700 IF(I2.NE.LCC)GO TO 112
30800 IF(I3.EQ.IT)GO TO 1278
30900 C ACT=ACCENT. NEXT FOR AC (=ACCEL.)
31000 RD=80
31100 GO TO 1442
31200
31300 478 IF(I2.GE.IBLA)GO TO 883
31400 C 'D' DIM →578, DOWN →883, DELETE →112 OR 883 DP →886
31500 IF(I2.NE.LEE)GO TO 578
31600 IF(X22.NE.0)GO TO 883
31700 GO TO 112
31800 578 IF(I2.EQ.IP)GO TO 886
31900 IF(I2.NE.II)GO TO 59
32000 C NEXT FOR DIM.=82
32100 IF(X22.NE.0)GO TO 59
32200 RD=82
32300 GO TO 1442
32400
32500 1591 I1=LEL
32600 9591 FSCN=I1
32700 GO TO 5917
32800 2591 I1=IR
32900 GO TO 9591
33000 3591 I1=IU
33100 GO TO 9591
33200 4591 I1=LDD
33300 GO TO 9591
33400 7591 I1=IXX
33500 GO TO 5591
33600 5912 I1=LCC
33700 GO TO 5591
33800 5913 I1=FSCN
33900 IF(FSCN.EQ.LEL)GO TO 5914
34000 IF(FSCN.EQ.IR)GO TO 5914
34100 C NEXT FOR UP-DOWN
34200 UD=UD/2
34300 GO TO 5917
34400 5914 RL=RL/2
34500 GO TO 5917
34600 6591 I1=FSCN
34700 IF(I1.EQ.LEL)GO TO 5916
34800 IF(I1.EQ.IR)GO TO 5916
34900 UD=UD*2
35000 GO TO 5917
35100 5916 RL=RL*2
35200 GO TO 5917
35300
35400
35500 C 'S'=SET, SA=SAVE, SB=SAVE BIG, SM=BIG+SAME NAME, ST=STAFF, SP=SPC STF.
35600 C SC=SPACING SCALE ABOVE STAFF n (99=DELETE IT)
35700 15 IF(I2.EQ.IT)GO TO 885
35800 IF(I2.EQ.LAA)GO TO 3121
35900 IF(I2.EQ.LCC)GO TO 886
36000 IF(I2.EQ.LDD)GO TO 3121
36100 IF(I2.EQ.LEE)GO TO 312
36200 IF(I2.EQ.IBLA)GO TO 312
36300 IF(I2.EQ.IP)GO TO 87
36400 IF(I2.EQ.LHH)JFONT=1
36500 IF(I3.EQ.IXX)JFONT=0
36600 IF(I3.EQ.IP)JFONT=-1
36700 IF(I3.EQ.LOH)JFONT=-2
36800 IF(I3.EQ.II)JFONT=-3
36900 C 'SH'(=SHOW) IS SAME AS 44 1. SHOWS TYPE FONTS ON DPY.
37000 C 'SHP' = SHOW ONLY AS 'PRIMATIVE' FONT, 'SHX' = CANCEL FONTS ON DPY.
37100 C 'SHO' = FONT SET (TEMPORARILY) TO 'BDR'; 'SHI' = 'BDI' (ITALICS)
37200 IF(I2.NE.LFF)GO TO 3122
37300 RD=45
37400 IF(I3.NE.IZ)GO TO 1442
37500 RD=92
37600 3123 REREAD 1,JA,JA,JA,R2,RJQ
37700 R5=RD
37800 GO TO 442
37900 3122 IF(I2.NE.IM)GO TO 5505
38000 C ONLY FOR ST, SA, SB, SM, RS, S, SF=45, SFZ=92
38100 3121 IF(X22.NE.0)GO TO 5505
38200 SAVER=4
38300 CALL SAVIT
38400 GO TO 5505
38500 312 JA=55
38600 R2=RN(MEDIT+3)
38700 C POSITION OF ITEM LOOKED AT.
38800 R3=55.
38900 GO TO 6531
39000 C ABOVE FOR 'S'ET ALIGNMENT
39100 C 'S'=SET ALIGNMENT, 'A'=ALIGN IT. 'M'=MOVER 'C'= COPIER
39200 C 'E'=EDIT; 'I'=ITEM; 'G'=GET; 'GM'=GET MORE;
39300 878 K=-1
39400 DO 882 JA=3,10
39500 882 IF(INP(JA).NE.IBLA)GO TO 886
39600 GO TO 883
39700 885 FORMAT(A2,21F)
39800 IF(X22.NE.0)GO TO 59
39900 C CAN'T DO 'ST' IF ALREADY IN EDIT MODE.
40000 IF(I3.EQ.LCC)GO TO 1578
40100 C STC=STACCATO
40200 886 REREAD 885,K,R2,RJQ
40300 JA=55
40400 IF(I2.NE.LCC)GO TO 101
40500 CALL SCL
40600 GO TO 5505
40700 101 IF(I2.NE.LDD)GO TO 988
40800 IF(I1.EQ.LAA)JA=19
40900 C 'AD'just stems to beams.
41000 988 IF(I2.EQ.IT)JA=44
41100 IF(I2.EQ.INN)GO TO 188
41200 IF(I2.NE.IP)GO TO 6531
41300 IF(R2.GT.7)GO TO 1886
41400 C GO BACK AND RESET ALL IF STF NUM >7
41500 K=R2
41600 JA=0
41700 C USE '8' FOR STAFF 0.
41800 888 IF(K.EQ.8)K=0
41900 DP(K)=-DP(K)
42000 JA=JA+1
42100 K=RJQ(JA)
42200 IF(K.EQ.0)GO TO 55
42300 C JUMP OUT IF RJQ(JA)=0 OR 99
42400 IF(K.EQ.99)GO TO 85
42500 C*** 3/74 END WITH '99' TO MAKE DP RIGHT NOW!
42600 GO TO 888
42700 1886 DO 2886 K=0,7
42800 2886 DP(K)=1
42900 GO TO 85
43000 C TO GET BACK OTHERS - 'DPY N' AGAIN WILL DO.
43100
43200 778 IF(I2.NE.IP)GO TO 883
43300 C 'LP'=LIGHT PEN. TO BE USED ONLY IN EDIT MODE
43400 78 IF(X22.EQ.0)GO TO 59
43500 C 'X' GO BACK IF NOT IN EDIT MODE
43600
43700 C NEXT FOR READ, RS, DEL, L,R,U,D
43800 883 IF(IX.EQ.I)GO TO 8834
43900 C CAN'T DELETE ('DE') AFTER A PARAM HAS BEEN CHANGED. START OVER.
44000 IF(I2.NE.LEE)GO TO 8831
44100 GO TO 5505
44200
44300 8835 IF(I2.GE.IBLA)GO TO 8831
44400 C R=RIGHT MOVE, RI=RIT., RS=RESTART, READ=READ
44500 IF(X22.NE.0)GO TO 59
44600 C GO BACK IF STILL IN EDIT MODE.
44700 IF(I2.EQ.IS)GO TO 2
44800 C TYPE 'RS' TO RESTART.
44900 IF(I2.NE.II)GO TO 8830
45000 C NEXT FOR RIT.=37
45100 RD=37
45200 GO TO 1442
45300
45400 8830 JA=144
45500 C 'READ' IS SAME AS 144
45600 GO TO 88
45700
45800 8834 IF(I1.EQ.LCC)GO TO 72
45900 8831 IF(JA.NE.16)GO TO 8832
46000 IF(X22.EQ.0)GO TO 5505
46100 C CAN'T MOVE LETTERS OR 'SCORE' ENTRIES UNLESS REALLY IN EDIT MODE!
46200 8832 CALL EDIT(JJA)
46300 IF(JA.NE.99)GO TO 6531
46400 CALL DELETE
46500 C DELETE ROUTINE COULD BE PUT DIRECTLY IN HERE.
46600 GO TO 425
46700 89 FORMAT(72A1)
46800 C TYPE L, R, U OR D OR EDIT TO MOVE LAST ENTERED ITEM.
46900
47000 410 IF(QUICK.NE.0)GO TO 510
47100 C ↑↑↑ SO 'N n' WILL WORK EVEN AFTER N HAS BEEN SET.
47200 QUICK=1
47300 C TYPE 'N' =NO-TYPE PARAMS TO SUPPRESS TYPE-OUT WHILE EDITING.
47400 IF(X22.NE.0)GO TO 87
47500 510 I1=II
47600 C 'N n' WHEN NOT IN EDIT MODE = 'I n'<CR>,'N'<CR>
47700 87 IF(I1.NE.II)GO TO 610
47800 678 IF(I2.EQ.INN)GO TO 886
47900 C 'IN n,n,n,' MUST BE READ AGAIN AT 886 TO GET n'S CORRECTLY.
48000 JA=22
48100 GO TO 6531
48200
48300 610 IF(K)JA=55
48400 C ED 47 -1 = 55 47 -1, ETC.
48500 IF(JA.EQ.101)GO TO 101
48600 IF(I1.NE.INN)GO TO 710
48700 IF(R2.NE.0)GO TO 510
48800 C IF NO NUM FOLLOWS 'N' GO PRINT OUT CURRENT PARAMS.
48900 GO TO 10
49000
49100 C 'Z' = ZOOM (OLD CODE# 24)
49200 710 IF(I2.NE.IP)GO TO 441
49300 RSET4=R3
49400 C SPn SETS "SETUP" STAFF NUMBER
49500 GO TO 5505
49600 C 'SP' IS SAME AS 444
49700 C 'P n' = PRINT CURRENT CONTENTS OF PARAM n. (ONLY WHILE IN EDIT MODE.)
49800 441 IF(X22.EQ.0.OR.I2.EQ.LEL)GO TO 288
49900 C JUMP OUT IF 'TL' (TYPLOC)
50000 QUICK=0
50100 C TYPE 'T' TO RESET PARAM TYPE-OUT
50200 IF(R2.EQ.0)GO TO 5505
50300 GO TO 510
50400
50500 1078 RD=14
50600 C PLUS
50700 1178 REREAD 885,JA,R2,RJQ
50800 1378 J=9
50900 R5=RD
51000 IF(R4.EQ.0)R4=15
51100 GO TO 110
51200 1278 RD=5
51300 C ACCENT
51400 1478 REREAD 1,J,J,J,R2,RJQ
51500 GO TO 1378
51600 1578 RD=7
51700 C STACC.
51800 GO TO 1478
51900 1678 RD=13
52000 C HARMONIC
52100 IF(I2.EQ.IW)RD=21
52200 C HEAVY WEDGE
52300 GO TO 1178
52400 1778 RD=4
52500 C WEDGE
52600 GO TO 1178
52700
52800 3442 REREAD 885,JA,R2,RJQ
52900 R5=26
53000 J=9
53100 IF(R4.EQ.0)R4=12
53200 C FERMATA
53300 GO TO 110
53400
53480 2442 IF(I2.EQ.II)GO TO 502
53490 IF(X22.NE.0)GO TO 59
53500 R5=51
53600 C F=51 FF=52 FFF=53, FE=FERMATA, FILE
53700 IF(I2.EQ.IBLA)GO TO 442
53800 IF(I2.EQ.LEE)GO TO 3442
54000 RD=53
54100 IF(I3.NE.IBLA)GO TO 3123
54200 RD=52
54300 1442 REREAD 885,JA,R2,RJQ
54400 R5=RD
54500 442 J=3
54600 IF(R4.EQ.0)R4=-5
54700 C ABOVE IS FOR DIRECT TYPING OF P,PP,PPP,MP,RIT., ETC.
54800 C IF PARAM 4 IS 0, PUTS IT -5 BELOW.
54900 110 JA=J
55000 IF(JA.GT.0)SAVER=SAVER-1
55100 IF(X22.NE.0)GO TO 6531
55200 IF(SAVER)CALL SAVIT
55300 C SAVES EVERY 4TH TIME AROUND
55400 IF(JA.EQ.0)GO TO 5505
55500 C CATCHES ZEROS AND LOWER CASE LETTERS.
55600 GO TO 6531
55700 C NEXT FOR ALPHA TEXT ITEMS. 'T'=TYPE
55800 288 IF(I2.NE.LEE)GO TO 388
55900 RD=9
56000 C TENUTO
56100 GO TO 1178
56200 388 IF(I2.NE.LEL)GO TO 488
56300 J3=R3
56400 J4=R4
56500 C 'TL' SET LOCATION OF TYPE OUT ON SCREEN
56600 IF(J4.EQ.0)J4=J3-200
56700 C OMIT 2ND NUM. AND GET N AND N-200.
56800 IF(R3.NE.0)GO TO 588
56900 IF(R4.NE.0)GO TO 588
57000 J4=0
57100 J3=450
57200 C 'TL' 0 0 PUTS IT BACK TO ORIG. LOC.
57300 588 CALL TYPLOC(J3,J4)
57400 GO TO 5505
57500 488 JA=16
57600 C 'T' = TEST INPUT
57700 J2=R2
57800 M=I
57900 CALL WORDS
58000 SAVER=SAVER-1
58100 GO TO 8852
58200
58300 188 IF(X22.NE.0)GO TO 5505
58400 JA=14
58500 RMODE2=R3
58600 C TYPE 'IN STF# MODE' ETC. -- SAME AS 14 STF#.
58700 88 SCORE=0
58800 IF(JA.NE.14)GO TO 889
58900 C NEXT PUTS UP STAFF IF IT WASN'T THERE ALREADY
59000 SAVER=-1
59100 RSTF=R2
59200 IF(R3)R3=0
59300 DO 1889 K=1,ITEM
59400 J=PWDS(K)
59500 IF(RN(J+1).NE.8)GO TO 1889
59600 IF(RN(J+2).EQ.R2)GO TO 890
59700 1889 CONTINUE
59800 C DIDN'T FIND THIS STAFF
59900 M=LIMIT
60000 C ↑↑ WAS =2000 6/78
60100 IGO=0
60200 JA=8
60300 R3=0
60400 GO TO 6531
60500 890 JA=14
60600 ITCHK=ITEM
60700 ICHK=I
60800 IDPY=ST2
60900 C ALL THIS FOR BACKUPS
61000 889 SPD=ST2
61100 JIT=ITEM
61200 ISC=I
61300 REND=0
61400 C RETAINS ORIGINS OF SCORE SQUENCE
61500 9532 IF(REND.EQ.2)GO TO 889
61600 C FOR READIN CONTINUATION.
61700 M=ISC
61800 9533 IF(JA.EQ.8)GO TO 890
61900 IF(REND)GO TO 9535
62000 C REND=0 GO, -1=NORMAL END, 1=ABORTED.
62100 CALL SCMSS
62200 IF(REND.EQ.1)GO TO 9535
62300 IF(REND.NE.99)GO TO 9534
62400 I=ICHK
62500 ITEM=ITCHK
62600 ST2=IDPY
62700 CALL ACCPOG(1)
62800 CALL DPYOUT(1)
62900 GO TO 9535
63000 9534 ITEM=JIT
63100 J=M
63200 9536 ITEM=ITEM+1
63300 PWDS(ITEM)=J
63400 J=J+RN(J)+3
63500 IF(J.LT.I)GO TO 9536
63600 IF(IBEAM)GO TO 9537
63700 R13=0
63800 R2=RSTF
63900 JA=19
64000 J3=0
64100 CALL HOMER
64200 9537 ITEM=JIT
64300 ST2=SPD
64400 GO TO 8852
64500 9535 SCORE=-1
64600 CALL SHRINK(JIT)
64700 C GETS RID OF ZEROS AT END OF NOTE PARAM LIST.
64800 IGO=-1
64900 JA=16
65000 C FOR TRAP AT 'EDIT'
65100 GO TO 5505
65200
65300 112 IGO=1
65400 CALL GRED
65500 JFONT=0
65600 IF(JA.EQ.98)GO TO 5533
65700 KNT=0
65800 SCORE=0
65900
66000 653 KNT=KNT+1
66100 C NUM OF ITEMS IN LIST
66200 R11=0
66300 R10=0
66400 R9=0
66500 JA=R(1,KNT)
66600 R2=R(2,KNT)
66700 IF(JA.NE.0)GO TO 550
66800 C =0 MEANS NO MORE ITEMS.
66900 CALL DPYOUT(1)
67000 GO TO 1100
67100
67200 5533 X22=0
67300 IGO=-1
67400 CALL DPYNEW
67500 GO TO 55
67600
67700 550 DO 7531 K=1,6
67800 7531 RJQ(K)=R(K+2,KNT)
67900 6531 M=1
68000 EDX=-1
68100 IF(JA.EQ.222)GO TO 72
68200 IF(JA.EQ.2222)GO TO 73
68300 DO 5532 K=1,20
68400 5532 JQ(K)=RJQ(K)
68500 C X22= ITEM# WHEN EDITING OR DELETING.
68600 IF(X22.NE.0)GO TO 5511
68700 IF(JA.GT.0)GO TO 155
68800 IF(R2.EQ.0)GO TO 5505
68900 C FOR UP, DOWN, LEFT, RIGHT
69000 RJJ2=J2
69100 GO TO 6221
69200 C GOES BACK IF NEGATIVE AND NOT IN EDIT MODE.
69300 155 IF(JA.EQ.22)GO TO 42
69400 IF(JA.EQ.44)GO TO 44
69500 C THIS '44' IS SET IN 'EDIT' - IT'S NEVER TYPED.
69600 IF(JA.EQ.55)GO TO 554
69700 IF(JA.NE.19)GO TO 60
69800 271 CALL HOMER
69900 GO TO 8853
70000
00100 33 IF(X22.EQ.0)GO TO 6333
00200 C WHEN NOT IN EDIT MODE(X22=0) "P n n2" LISTS ALL PARAMS FOR ITEMS n→n2.
00300 J2=R2
00400 TYPE 331,J2,RJJ(J2-2)
00500 C TYPE P n TO SEE FULL CONTENTS OF PARAM. n.
00600 GO TO 5505
00700 331 FORMAT(I,F15.5)
00800
00900 24 IF(X22.NE.0)GO TO 59
01000 C 'Z' = ZOOM CAN'T DO ZOOM WHILE IN EDIT MODE
01100 JA=24
01200 IGO=0
01300 23 IF(R2.LT.100)GO TO 2410
01400 R3=AMOD(R2,100.)
01500 R2=(R2-R3)/100.
01600 R4=R2*6-R2
01700 C TYPE 24 200.5 FOR 1ST HALF OF DOUBLE, 301 FOR LAST THIRD OF TRIPLE
01800 2410 IF(R2.NE.0)GO TO 241
01900 IGO=-1
02000 243 R2=1.
02100 C TO REDISPLAY WITH MAGNIFICATION - OR JUST RUN THROUGH DATA.
02200 241 RSZ=.845*R2
02300 JCEN=(R3*10-500)*RSZ
02400 KCEN=(R4*10-480)*RSZ
02500 C NEXT TO RECONSTITUTE SPACING SCALE.
02600 IF(R2.GT.1)GO TO 240
02700 JCEN=0
02800 KCEN=0
02900 IF(R2.EQ.1)GO TO 3312
03000 240 R2=(R4-100.)/100.
03100 C%%%%%%%%%%%%%
03200 IF(R2.LT.0)R2=0
03300 C WE DON'T WORRY IF IT'S TOO HIGH (YET).
03400 3312 R4=0
03500 R2=R2+1
03600 CALL SCL
03700 R2=0
03800 R3=0
03900 R4=0
04000 LCEN=0
04100 MCEN=0
04200 C IF P5 ≠ 0 GOES THROUGH DATA IN OLD WAY.
04300 JFONT=0
04400 85 M=1
04500 I=PWDS(ITEM+1)
04600 ITEMX=ITEM
04700 C FOR USE IN CENTERING WHOLE RESTS (IN NOTWRT [NTSM.FAI])
04800 ITEM=0
04900 8552 ST2=3
05000 8852 PLT=1
05100 EDX=0
05200 CALL ACCPOG(1)
05300 IF(JA.EQ.0)GO TO 6120
05400 IF(JA.NE.24)IGO=0
05500 GO TO 6120
05600
05700 6333 IF(I2.EQ.IR)GO TO 6334
05800 C NOW TYPE 'PR' TO PRINT PARAMETER LIST
05900 R5=42
06000 IF(I2.EQ.IBLA)GO TO 442
06100 IF(I2.EQ.IP)RD=41
06200 C PPP=40 PP=41 P=42 POCO=72 PIU=91
06300 IF(I2.EQ.II)RD=91
06400 IF(I2.EQ.LOH)RD=72
06500 IF(I2.EQ.LEL)GO TO 1078
06600 C PLUS
06700 IF(I2.EQ.IZ)GO TO 7078
06800 C PIZZ
06900 IF(I3.EQ.IBLA)GO TO 1442
07000 RD=40
07100 GO TO 3123
07200 6334 CALL LISTP(LST)
07300 GO TO 5505
07400
07500 7078 RA=51857895.
07600 RB=95389999.
07700 C PIZZ.
07800 7578 RD=0
07900 7978 RE=1
08000 7878 J=16
08100 REREAD 885,JA,R2,RJQ
08200 R6=RA
08300 R7=RB
08400 R8=RD
08500 IF(R5.EQ.0)R5= RE
08600 IF(R4.EQ.0)R4=14
08700 C 0=PUT IT ABOVE STAFF
08800 GO TO 110
08900 7178 RA=51704789.
09000 RB=74828584.
09100 RD=99999999.
09200 C A TEMPO
09300 GO TO 7978
09400 7278 RA=51708772.
09500 RB=84999999.
09600 C ARCO
09700 GO TO 7578
09800 7378 RA=40999999.
09900 7678 RB=0
10000 GO TO 7578
10100 C LEFT AND RIGHT PARENTHESES AND COMMA
10200 7478 RA=41999999.
10300 GO TO 7678
10400 7778 RA=36999999.
10500 RB=0
10600 RD=0
10700 RE=1.5
10800 C COMMA IS DEFAULT SIZE 1.5
10900 GO TO 7878
11000
11100 172 CALL JUGGLE
11200 CALL CLRCUR
11300 CALL DPYNEW
11400 IF(JA.EQ.22)GO TO 424
11500 C FOR MOVING DIRECTLY TO NEW ITEM IN EDIT MODE.
11600 IF(ZERO)GO TO 55
11700 X22=ZERO
11800 ZERO=-1
11900 IF(JA.EQ.55)GO TO 554
12000 IF(JA.EQ.44)GO TO 44
12100 IF(KED.NE.0)GO TO 244
12200 GO TO 425
12300
12400 C 55,POS -- SETS UP ALIGNMENT
12500 554 IF(I2.NE.IS)GO TO 2554
12600 CALL EXCH(R2,R3)
12700 CALL EXCH(J2,J3)
12800 C 'ES' IS "EDIT, STAFF, POS., CODE"
12900 C 'ED' IS "EDIT, POS., STAFF, CODE"
13000 2554 CALL BOX(-1,R2)
13100 IF(J4.EQ.0)KED=-1
13200 RITEM=R4
13300 C FOR 'ED POS., STF., CODE#' (STF > 7 = ALL STAVES)
13400 IF(J3.GT.7)KED=-2
13500 RLINE=R2
13600 R2=R3
13700 GO TO 45
13800
13900 C '22,0' EDITS LAST ITEM ENTERED
14000 42 REDIT=999.0
14100 IF(R2.NE.0)GO TO 242
14200 X22=ITEM
14300 GO TO 429
14400 44 KED=1
14500 RITEM=R3
14600 C 'ST*, STF#, CODE# (IF 0, ALL ITEMS COME UP) - STF>7 = ALL STAVES.
14700 IF(R2.GT.7)KED=2
14800 45 REDIT=R2
14900 C THE STAFF #
15000 JED=1
15100 244 X=ITEM
15200 IF(JED.GT.X)GO TO 444
15300 DO 144 K=JED,X
15400 L=PWDS(K)
15500 IF(KED.EQ.-2)GO TO 654
15600 C -2 LOOKS AT ALL ITEMS NEAR VERT. LINE, -1 ON SINGLE STAFF.
15700 IF(KED.EQ.2)GO TO 656
15800 IF(RN(L+2).NE.REDIT)GO TO 144
15900 IF(KED)GO TO 654
16000 IF(RITEM.EQ.0)GO TO 655
16100 656 IF(RITEM.NE.RN(L+1))GO TO 144
16200 655 IF(JA.NE.55)GO TO 344
16300 654 IF(ABS(RLINE-RN(L+3)).LT.5.0)GO TO 344
16400 144 CONTINUE
16500 444 REDIT=999.
16600 C NO MORE ON LINE
16700 R2=0
16800 C SO IT WILL RETURN IF NOTHING IS FOUND WITH 'ED' OR 'ST'.
16900 GO TO 73
17000 344 JED=K+1
17100 C FOR NEXT TIME AROUND
17200 X22=K
17300 GO TO 429
17400 C CR MOVES ALONG GIVEN LINE, 222 LEAVES THIS MODE
17500
17600 91 CALL ACCPOG(1)
17700 IF(I.EQ.IX)ITEM=ITEM-1
17800 GO TO 142
17900 242 IF(X22.GT.0)GO TO 5511
18000 142 IF(R2.NE.0)GO TO 424
18100 IF(REDIT.EQ.999)GO TO 1554
18200 IF(JA.GE.0)GO TO 244
18300 1554 X22=X22+1
18400 IF(JA)X22=X22-1+JA
18500 IF(X22.LT.1)X22=1
18600 GO TO 425
18700 CCC427 FORMAT(1XA5/,2F6.0,F10.2,$)
18800 CC1427 FORMAT(/,2F6.0,F10.2,$)
18900 CCC4271 FORMAT('+ (',I2,')',F7.2,$)
19000
19100 C FOR EDITING
19200 5511 IF(JA.EQ.55)GO TO 420
19300 220 IF(JA.NE.22)GO TO 720
19400 C 'I, #' WILL MOVE TO ANOTHER ITEM WHEN ALREADY IN EDIT MODE.
19500 KED=0
19600 JED=0
19700 GO TO 72
19800 720 IF(JA.EQ.44)GO TO 420
19900 C FOR '24' WHILE IN EDIT MODE. MAGS WITH CURSOR AS CENTER.
20000 IF(JA.GT.100)GO TO 4221
20100 IF(JA.GT.13)GO TO 5505
20200 C PARAM NUM TOO HIGH? LOOKS FOR NEXT ITEM TO EDIT IF <CR>
20300 4221 IF(X22.EQ.0)GO TO 5517
20400 IF(R2.NE.0)GO TO 5517
20500 C BACKS UP WHEN IN EDIT MODE.
20600
20700 IF(JA.GT.0)GO TO 5518
20800 IF(I.EQ.IX)GO TO 91
20900 ZERO=X22+1
21000 C '0' AFTER AN EDIT ENDS THE EDIT AND GETS NEXT ITEM FOR EDIT.
21100 72 IF(X22.EQ.0)GO TO 55
21200 IF(KED.EQ.0)REDIT=999.
21300 320 IF(I.NE.IX)GO TO 172
21400 ITEM=ITEM-1
21500 C TO DELETE AN ITEM
21600 73 X22=0
21700 CALL CLRCUR
21800 CALL DPYNEW
21900 IF(REDIT.EQ.999.)GO TO 428
22000 IF(JA.EQ.55)GO TO 554
22100 IF(JA.EQ.44)GO TO 44
22200 428 IF(R2.EQ.0.OR.R2.GT.ITEM)GO TO 55
22300 C DELETION IN EDIT MODE DOES NOT LEAVE MODE.
22400 424 X22=R2
22500 425 IF(X22.GT.ITEM)GO TO 73
22600 C LEAVES EDIT MODE.
22700 429 IX=I
22800 MEDIT=PWDS(X22)
22900 J=2
23000 426 Y=RN(MEDIT)+J
23100 CALL LOOP(0,Y,1,I,MEDIT,RN)
23200 JJA=RN(I+1)
23300 YED=Y-2
23400 L=I+2
23500 DO 422 K=1,11
23600 IF(K.GT.YED)GO TO 423
23700 RJJ(K)=RN(L+K)
23800 GO TO 422
23900 423 RJJ(K)=0
24000 422 CONTINUE
24100 RJJ2=RN(L)
24200 IF(IGO.GT.0)GO TO 4231
24300 C NO BOX WHEN IN GROUP EDIT ROUTINE
24400 IBOX=I
24500 RBOX=RJJ2
24600 CALL BOX(IBOX,RBOX)
24700 4231 ITEM=ITEM+1
24800 ST2=WDS(ITEM)
24900 GO TO 55
25000
25100 5517 IF(JA.EQ.0)GO TO 6221
25200 5518 X=100-JA
25300 IF(X)JA=JA/100
25400 IF(JA.LE.2)GO TO 7221
25500 IF(JA.LE.13)GO TO 324
25600 JA=JA/10
25700 C ADD 1000 TO PARAM TO MAKE EQUAL TO ANOTHER PARAM
25800 X=R2-2.
25900 RJJ(JA-2)=RJJ(X)
26000 GO TO 6222
26100 324 I1=JA-2
26200 IF(X)GO TO 224
26300 RJJ(I1)=R2
26400 GO TO 6222
26500 224 RJJ(I1)=RJJ(I1)+R2
26600 GO TO 6222
26700
26800 178 IF(X22.EQ.0)GO TO 7555
26900 C 'C' = COPY (IN OR OUT OF EDIT MODE) CR=CRESC.
27000 IF(I2.EQ.IBLA)GO TO 883
27100 R2=1
27200 C CN=CENTER, CH=AT HEAD, CT=AT TAIL, CX=EXIT FROM CENTERING MODE.
27300 JA=13
27400 IF(I2.EQ.IXX)R2=0
27500 IF(I2.EQ.LHH)R2=-R2
27600 IF(I2.EQ.IT)R2=-2
27700 IF(I2.EQ.LBB)CB=6
27800 C TYPE 'CB' FOR CENTER-BIG (BIG RANGE =6) ******
27900 GO TO 6531
28000 CC278 IF(X22.NE.0)GO TO 59
28100 7555 IF(I2.EQ.IBLA)GO TO 7556
28200 C NEXT FOR ME=MENO=81 MOLTO=90 CRESC.=70 MP=43 MF=50
28300 RD=43
28400 IF(I2.EQ.LFF)RD=50
28500 IF(I2.EQ.LOH)RD=90
28600 IF(I2.EQ.LEE)RD=81
28700 IF(I2.EQ.IR)RD=70
28800 GO TO 1442
28900 7556 CALL MOVER
29000 IF(R2.EQ.99)GO TO 59
29100 C 99=BACKUP OUT OF MOVER ETC.
29200 IGO=0
29300 JFONT=0
29400 C SO IT WON'T DO ALL FONT LOOKUPS.
29500 8853 IF(JJ2)GO TO 5505
29600 M=PWDS(JJ2)
29700 I=PWDS(ITEM+1)
29800 ITEM=JJ2-1
29900 ST2=WDS(JJ2)
30000 C SO IT DOESN'T HAVE TO GO THROUGH ALL ITEMS
30100 GO TO 8852
30200
30300 420 REDIT=0
30400 211 IF(R2.NE.0)GO TO 320
30500 IF(KED.GE.0)RLINE=RJ3
30600 RJ3=RLINE
30700 GO TO 6222
30800 C FOR '55' ALIGNING
30900 7221 IF(X)GO TO 4223
31000 CALL PARCH(JA,JJA,R2)
31100 GO TO 6222
31200 4223 RJJ2=R2+RJJ2
31300 C ARRAYS NEED 2O LOCATIONS HERE.
31400 C CHNG PARAMS WITH PAIRS OF NUMS.(EG. 2,122 4,13 5,-2 ETC.)
31500 6222 DO 1222 K=1,20,2
31600 L=JQ(K)
31700 IF(L.EQ.0)GO TO 6221
31800 C '600 2' WILL ADD 2 TO PARAM 6. '3000 6' SETS P3=P6.
31900 RD=RJQ(K+1)
32000 X=L
32100 IF(L.LT.100)GO TO 223
32200 IF(L.LT.2000)GO TO 5223
32300 X=L/1000
32400 L=JQ(K+1)-2
32500 RD=RJJ(L)
32600 GO TO 2223
32700 5223 X=L/100
32800 IF(X.EQ.2)GO TO 1223
32900 RD=RJJ(X-2)+RD
33000 GO TO 2223
33100 1223 RD=RJJ2+RD
33200 223 IF(X.LE.2)GO TO 3223
33300 2223 RJJ(X-2)=RD
33400 GO TO 1222
33500 3223 CALL PARCH(X,JJA,RD)
33600 C NOW P1 CAN BE CHANGED IN EDIT MODE -- BE CAREFUL,,,,!!!!!!
33700 1222 CONTINUE
33800 C*** LOOP SET TO 11 (20 IN ARRAY!) ONLY 13 PARAMS POSSIBLE NOW.
33900 6221 DO 5514 K=1,11
34000 R2=RJJ(K)
34100 RJQ(K)=R2
34200 5514 JQ(K)=R2
34300 R2=RJJ2
34400 JA=JJA
34500 ITEM=ITEM-1
34600 IF(ITEM)ITEM=0
34700 ST2=WDS(ITEM+1)
34800 I=PWDS(ITEM+1)
34900 CALL DPYNEW
35000
00100 60 J2=R2
00200 IF(J2.LT.0)GO TO 5505
00300 IF(J2.GT.7)GO TO 5505
00400 C STOPS TYPO ERROR ON STAFF NUM. (<0, >7)
00500 RSTJ2=RSTFAC(J2)
00600 C* IF(JA.NE.2)GO TO 163
00700 C* IF(R8.EQ.0)GO TO 163
00800 C* IF(R8.EQ.-1)GO TO 163
00900 C* IF(R8.EQ.-4)GO TO 163
01000 C R8=0=AS IS; -1=WHOLE REST; >0=NUMBER OVER REST; -2=CENTERED
01100 C R8=-3 = CENTERED REST (BUT NOT CHANGED TO WHOLE)
01200 C R8=-4 = MEASURE REPEAT SIGN. =-5 = REPEAT SIGN CENTERED.
01300 C* K=ITEM
01400 C ITEM+1 IS CURRENT ITEM IN QUICK RUN-THROUGHS.
01500 C* IF(X22.NE.0)K=X22-1
01600 C* RD=1.75*RSTJ2
01700 C* L=PWDS(K+2)
01800 C* IF(RN(L+1).NE.4)GO TO 164
01900 C GO ON IF NEXT ISN'T BAR LINE (CODE 4. NEXT FINDS OTHER LINES!!)
02000 C* IF(RN(L+2).NE.R2)GO TO 164
02100 C* RB=RN(L+3)
02200 C* L=PWDS(K)
02300 C CHECK PREV. AND NEXT ITEM. IF NOT BAR, DON'T TRY TO CENTER!
02400 C* IF(RN(L+1).NE.4)GO TO 164
02500 C* IF(RN(L+2).NE.R2)GO TO 164
02600 C JUMP IF NOT ON SAME STAFF
02700 C* RA=RN(L+3)
02800 C* R3=RA+(RB-RA)/2-1.75*RSTJ2
02900 C*164 IF(PLT.EQ.0)GO TO 160
03000 C* RN(PWDS(K+1)+3)=R3
03100 C ******* A DANGEROUS PLACE. KEEP TRACK OF THIS
03200 C* GO TO 5541
03300
03400 163 IF(JA.EQ.16)GO TO 63
03500 IF(PLT.NE.0)GO TO 5541
03600 IF(JA.NE.8)GO TO 70
03700 IF(R9.NE.1)GO TO 160
03800 L=7
03900 K='INST.'
04000 C RJQ(7) IS R9
04100 71 RA=RN(MEDIT+L+2)
04200 CALL TYPCHR(RA,5)
04300 CCCC TYPE 427,RA
04400 CALL TYPCRLF
04500 CALL TYPSTR('TYPE ')
04600 CALL TYPCHR(K,5)
04700 CALL TYPSTR(' NAME ')
04800 CCC721 FORMAT(' TYPE ',A5,' NAME '$)
04900 CCC TYPE 721,K
05000 READ(IDEV,FA5)RD
05100 RJQ(L)=RD
05200 IF(RD.NE.' ')GO TO 160
05300 IF(RN(MEDIT).LT.L)RA=0
05400 C RESTORES NAME IF THERE WAS ONE ALREADY. ELSE=0
05500 RJQ(L)=RA
05600 C WHEN P9=1 ASKS FOR ID NAME FOR THE STAFF (FOR PART EXTRACTOR)
05700 GO TO 160
05800 CF371 FORMAT(A5,A1,A3)
05900 70 IF(JA.NE.11)GO TO 160
06000 C ↑↑↑↑ WAS - TO 63
06100 IF(J10.NE.1)GO TO 160
06200 K='FILE'
06300 L=8
06400 C P10←1 GETS NAME OF BASIC DRAW FILE, PUTS IT IN P10 (NJR)
06500 GO TO 71
06600 C IF NO NAME ASKED FOR, IT TAKES LAST NAME GIVEN.(SOLVES SORT PROB?)
06700 63 RD=R5
06800 IF(RD.GE.100)RD=RD-100
06900 C ADD 100 TO SZ TO MAKE TEXT APPEAR IN ALL SEPARATE PARTS OF ORCH. SCORE.
07000 IF(J10.EQ.0)GO TO 162
07100 L=ITEM
07200 IF(X22.NE.0)L=X22-1
07300 IF(J10.EQ.1)GO TO 263
07400 C ↓↓↓↓ TEMP. FIX TO CNVT TEXT FORMAT TO NEW STYLE. "10 99"
07500 IF(J10.NE.99)GO TO 863
07600 X=PWDS(X22)+6
07700 DO 563 L=X,X+2
07800 RB=RN(L)
07900 K=RB
08000 C CHECKS TO SEE WHICH FORMAT
08100 563 IF(K.NE.RB)GO TO 663
08200 GO TO 57
08300 663 DO 763 L=X,X+2
08400 763 RN(L)=RN(L)*100.
08500 GO TO 57
08600
08700 C NEXT FOR CENTERING TEXT. P10>1
08800 863 RB=0
08900 X=PWDS(L+1)
09000 363 L=L+1
09100 K=PWDS(L)
09200 RB=RB+RN(K+9)
09300 C ADD SPACE NEEDED
09400 K=PWDS(L+1)
09500 IF(RN(K+1).NE.16)GO TO 463
09600 IF(RN(K).EQ.8)GO TO 363
09700 C GO BACK IF MORE LETTERS TO COME
09800 463 R3=R10-(RB-3.4)*RD*RSTJ2/2.
09900 C +3.4 IS TO COMPENSATE FOR STARTING POS. BEING IN CENTER OF LET.
10000 R10=0
10100 IF(RN(X).EQ.8)RN(X+10)=0
10200 RN(X+3)=R3
10300 C THESE ARE NEEDED FOR ITEMS CENTERED DIRECTLY FROM 'WORDS'
10400 GO TO 162
10500 263 K=PWDS(L)
10600 R3=AMOD(RN(K+5),100.)*RSTJ2*RN(K+9)+RN(K+3)
10700 C AMOD BECAUSE P5+100 IS USED FOR PARTS PROGRAM.
10800 R4=RN(K+4)
10900 R5=RN(K+5)
11000 R2=RN(K+2)
11100 J2=R2
11200 L=PWDS(L+1)
11300 DO 361 JJA=3,5
11400 361 RN(L+JJA)=RJQ(JJA-2)
11500 RN(L+2)=R2
11600 162 IF(PLT.NE.0)GO TO 5541
11700 160 RJ3=R3
11800 JJA=JA
11900 IF(R8.NE.0)GO TO 161
12000 IF(JA.EQ.1)R8=999.
12100 C 999=0 FOR STEM EXTENSIONS.
12200 C USES ONLY 10 PARAMETERS BEYOND JA, J2
12300 161 CALL MSSLUP
12400 IF(JA.NE.6)GO TO 1261
12500 IF(J13.EQ.0)GO TO 171
12600 R2=X22
12700 X22=0
12800 R3=R13
12900 J3=J13
13000 R4=R11
13100 C RESET HOMING RANGE (DEFAULT=3) WITH P11.
13200 CALL CLRCUR
13300 R13=0
13400 C TYPE 13, n WITH BEAMS TO ADJUST IN RE. TO OTHER STAFF(LIKE OLD 'AD')
13500 JA=19
13600 GO TO 271
13700 171 CALL HOMER
13800
13900 1261 IF(R13.EQ.0)GO TO 261
14000 RD=R11
14100 IF(CB.NE.0.AND.RD.EQ.0)R11=CB
14200 C *** CB = CENTER-BIG I.E. BIG RANGE FOR CENTERING -- 6 UNITS. (CAN VARY LATER??)
14300 CALL HOMER
14400 CB=0
14500 R11=RD
14600 C R11 GETS CHANGED IN 'HOMER'
14700 CC IF(JA.EQ.2.AND.R9.NE.0)CALL RSTCEN
14800 C RSTCEN IS FOR CENTERING WHOLE RESTS.
14900 IF(JA.EQ.10)R3=R3+RSTJ2
15000 IF(JA.NE.9)GO TO 261
15100 IF(J5.GT.3)GO TO 261
15200 CALL NOZERO(R6)
15300 R3=R3+RSTJ2+2.*RSTJ2*R6
15400 C ABOVE HELPS CENTER NUMBERS UNDER NOTES(BECAUSE R3 IS AT CENTR OF NUM)
15500 C IF P13≠0 ANY ITEM WILL LINE UP WITH ANY OTHER ITEM. P13 IS RESET=0
15600 C P13=-1 POSITIONS ITEM ABOVE OR BELOW NOTE, =-2 JUST BEYOND STEM.
15700 C CODE 10 (NUMBERS) SPACED TO LEFT AS WELL AS CODE 9, P5=1,2,3 (FLAT,SHRP,NAT)
15800 C **** FOR '0' EDITS ******
15900 261 CALL LUP2
16000 5541 IF(DP(J2).GE.0)GO TO 61
16100 IF(JA.NE.8)GO TO 57
16200 C NOW GET SIZE FACTOR, IF IT'S THERE. (NEEDED IN 'SCORE' SECTION.)
16300 IF(R5.NE.0)RSTFAC(J2)=R5
16400 GO TO 57
16500 C*** 3/74 NEW DP SYSTEM
16600 C WHAT ABOUT EDITS?*******
16700 61 POS=STFF(J2)
16800 RX3=R3
16900 C SAVES IT IN RJQ(20) FOR OTHER ROUTINES.
17000 J3=ROFF(RHORZ(R3))
17100 C LINE IS DIVIDED INTO 200 POINTS.
17200 CALL CENTX
17300 C SETS VERT.(CENTR) POSITION BASED ON STAFF AND R4
17400 R3=J3
17500 IF(JA.LE.2)GO TO 11
17600 551 GO TO(1,1,68,25,67, 625,116,125,11,69, 68,12),JA
17700 GO TO (116,81,80),JA-15
17800 C FOR 16,17,18 (WORDS, KSIG, METER)
17900 IF(JA.EQ.99)GO TO 57
18000 C FOR PART EXTRACTOR TRANSPOSER - KEY SIG=0
18100 IF(JA.NE.33.AND.JA.NE.44)GO TO 222
18200 JA=JA/11
18300 C THIS IS TEMPORARY - TO READ PAGE TEMP. FILES.
18400 GO TO 551
18500
18600 222 I=PWDS(ITEM+1)
18700 GO TO 5505
18800 C 44 1; JFONT=ONE DISPLAYS FONTS - THIS ALSO CATCHES SOME TYPOS
18900
19000 69 CALL MAKNUM(R5)
19100 GO TO 57
19200
19300 68 CALL CLEFS
19400 GO TO 57
19500
19600 67 CALL SLUR
19700 GO TO 57
19800
19900 116 CALL ALPHA
20000 GO TO 57
20100
20200 81 CALL KSIG
20300 GO TO 57
20400
20500 80 CALL METER
20600 GO TO 57
20700
20800 125 IF(R2.EQ.0)RMOV=R8
20900 CALL STAFF
21000 GO TO 57
21100 CC625 IF(J10.LT.100)GO TO 1625
21200 CC CALL BEAMX
21300 CC GO TO 160
21400
21500 625 CALL BEAMX
21600 CC625 CALL BMSTF
21700 GO TO 57
21800 C BEAMS, STAFF LINES ****
21900 12 CALL CIRCLE
22000 GO TO 57
22100
22200 25 CALL ITMSUB
22300 C BAR LINES, ETC.
22400 GO TO 57
22500
22600 C TO GET DISPLAY: 'G'; 'GM' ADDS TO DPY;
22700 CC120 IF(X22.NE.0)GO TO 59
22800 C GO BACK IF STILL IN EDIT MODE
22900 120 J2=0
23000 IF(I.EQ.1)GO TO 1220
23100 L=NAME
23200 X=EXT
23300 IF(I2.NE.IM)GO TO 222
23400 C 'GM'=GET MORE(BUT OLD OUTPUT NAME IS RESTORED AT 2207)
23500 J2=-1
23600 1220 I1=-1
23700 CALL NAMEXT(INP,NAME,EXT)
23800 C NOW TYPE 'G NAME' OR 'GM NAME'
23900 IF(NAME.NE.IBLA)GO TO 1221
24000 1225 CALL TYPSTR(' NAME.EXT? ')
24100 CCC1225 TYPE 21
24200 READ(IDEV,89,END=3502)INP
24300 CQQ ACCEPT 89,INP
24400 C GO PUT A1'S INTO A5, ETC.
24500 CALL NAMEXT(INP,NAME,EXT)
24600 IF(NAME.EQ.IBLA)GO TO 2220
24700 IF(NAME.NE.'99')GO TO 1221
24800 C TYPE '99' TO BACK OUT OF 'SAVE'.
24900 NAME=L
25000 EXT=X
25100 GO TO 5505
25200 1221 IF(I1.NE.LESS)GO TO 1226
25300 IDEV=5
25400 GO TO 1225
25500 1226 IF(LOOKX(NAME,EXT).EQ.0)GO TO 1225
25600 C FUNC. LOOKD IS 'FAIL' PROG. TO CHECK ON LOOKUPS
25700 2220 JA=-1
25800 C -1 IS FOR 8852+3
25900 2200 J=ITEM+1
26000 IF(NAME.NE.IBLA)GO TO 2207
26100 CALL GETEXT('TMP','DMD')
26200 GO TO 2205
26300 2207 CALL GETEXT(NAME,EXT)
26400 2205 IF(J2.EQ.0)GO TO 2202
26500 NAME=L
26600 EXT=X
26700 2202 CALL EXTIN(RSTFAC,128)
26800 CALL EXTIN(PWDS(J),JJ2)
26900 CALL EXTIN(RN(I),IPOS)
27000 ITEM=ITEM+JJ2-2
27100 IF(J2)GO TO 2203
27200 CC IF(I2.EQ.IM)GO TO 2203
27300 C J2=-1=GM *******'GET MORE' DOES NOT GET MOTIVE LIST OF NEW FILE.*******
27400 IF(LCNT.GT.1)CALL EXTIN(LIST,LCNT)
27500 I=IPOS
27600 IF(RSTF.EQ.0)GO TO 85
27700 C (END OF V ARRAY)RSTF=-1 MEANS READ THE DPY BUFFER
27800 CALL EXTIN(ST,4302)
27900 CALL DPYNEW
28000 GO TO 5505
28100
28200 2203 M=I-1
28300 DO 2204 K=J,J+JJ2-2
28400 2204 PWDS(K)=PWDS(K)+M
28500 GO TO 85
28600 M=IX
28700 C IF P5=0 MOVES UP AT START, IF P6=0 MOVES UP AT END.
28800 C (J8) P8=1 OR 2 FOR 2-PASS PLOTS
28900 C 1.24 AND 1.2 ARE TO FIT 8 1/2 X 11 FORMAT
29000 C RMOV HAS INCHES FROM P8 OF STAFF 0.
29100 C R6=1 FOR NO MOVE AT END. R7=INCHES TO MOVE FOR NEW STAFF 0.
29200 C RE. R7:DISTANCE IS MEASURED FROM BOTTOM LINE OF STANDARD POSITION
29300 C OF STAFF 0 UP TO LOWEST!! POINT FOUND IN FOLLOWING FILE. THEN
29400 C NEXT SHIFT IS AGAIN FROM STANDARD STF.0 TO NEXT FILE'S LOW POINT.
29500 C MOVES PLOTTER UP IF P5=0.
29600
29700 C NEXT RUNS THROUGH DATA WITH NEW CHANGES.
29800 6120 IF(M.GE.I)GO TO 7120
29900 IF(IGO.EQ.0)GO TO 7121
30000 C USE "Z" TO DO FIXUP WHEN LIST IS SCRAMBLED !?X@!ZQ
30100 IF(M.EQ.PWDS(ITEM+1))GO TO 7121
30200 K=ITEM+1
30300 CALL TYPSTR(' FIXING ITEM ')
30400 CALL TYPINT(K)
30500 CALL TYPCRLF
30600 CCCC TYPE 7122,K
30700 PWDS(K)=M
30800 7121 CALL RUNTHR(M)
30900 IF(EDX.LE.0)GO TO 60
31000 GO TO 5505
31100 CCC7122 FORMAT(' FIXING ITEM ',I3)
31200
31300 7120 M=1
31400 IF(PLT.EQ.1)EDX=-1
31500 PLT=0
31600 GO TO 5505
31700 C ALWAYS START PLOT WITH BOTTOM UNIT ON PAGE AND WORK UP.
31800
31900 CCC56 FORMAT(/1XA5,' TYPE FOR ITEM #',I3,I,I6/)
32000 1 FORMAT(I,24F)
32100 CCC21 FORMAT(' NAME.EXT? '$)
32200 END